(** Fichiers de définitions auxiliaires *)
open Types

(** {2 Fonctions utiles pour la manipulations des valeurs WHILE - et d'affichage} *)

(** [print_value v] affiche la valeur [v] sur la sortie standard. *)
let print_value v =
  match v with
  | Int(n) -> print_int n
  | Bool(b) -> if b then print_int 1 else print_int 0

let string_of_value : value -> string =
  function
  | Int(i) -> string_of_int i
  | Bool(b) -> string_of_bool b

(** [int_to_value i] convertit l'entier [i] en valeur WHILE. *)
let int_to_value n = Int(n)

(*-- [string_to_var] convertit la chaine [v] en variable WHILE. --*)
let string_to_var v = Var(v)

(*-- [string_of_var] convertit la variable WHILE en chaine de caractère. --*)
let string_of_var (Var v) = v

(** [value_to_int v] convertit la valeur WHILE [v] en entier. *)
let value_to_int v =
  match v with
  | Int(n) -> n
  | _ -> failwith "la valeur n'est pas de type INT"

(** [bool_to_value b] convertit le booléen b en valeur WHILE. *)
let bool_to_value b = Bool(b)

(** [value_to_bool v] convertit la valeur WHILE [v] en booléen. *)
let value_to_bool v =
  match v with
  | Bool(b) -> b
  | _ -> failwith "la valeur n'est pas de type BOOL"

(** [lift_binop op v w] relève l'opérateur [op] sur les valeurs WHILE *)
let lift_binop op v w =
  match v, w with
  | Int(n), Int(m) -> Int(op n m)
  | _ -> failwith "v,w not INT"

(** [print_list l]  affiche une liste d'entier*)
let rec print_list_int l = 
  match l with
  | [] -> ()
  | a::l -> print_int a ; print_string " " ; print_list_int l

(** [print_list_couple_int] affiche une liste de couple d'entier *)
let rec print_list_couple_int (l: (int*int) list) = 
  match l with
  | [] -> ()
  | (a,b)::l -> print_string ("("^(string_of_int a)^","^(string_of_int b)^") "); print_list_couple_int l

(** [string_of_var_list] convertit une liste de variables en chaine de caractères. *)
let rec string_of_var_list vl = match vl with
  | [] -> ""
  | Var(v)::[] -> v
  | Var(v)::vl -> v^","^(string_of_var_list vl)

(** [string_of_expr] convertit une expression en chaine de caractères. *)
let string_of_expr : expr -> string =
  let paren chr ctxt prio =
    if ctxt >= prio then chr else ""
  in
  let paren_open  = paren "(" in
  let paren_close = paren ")" in
  let print_binop f ctxt prio op l r = 
     (paren_open ctxt prio)^(f prio l)^op^(f prio r)^(paren_close ctxt prio)
  in
  let print_uniop f ctxt prio op r =
     (paren_open ctxt prio)^op^(f prio r)^(paren_close ctxt prio)
  in
(*  let print_uniopInv f ctxt prio r op =
     (paren_open ctxt prio)^(f prio r)^op^(paren_close ctxt prio)
  in
*)  let rec aux ctxt = function
  | Expr_Var(s) -> string_of_var s
  | Expr_Num(i) -> string_of_value (Int i)
  | Expr_Neg(e) -> print_uniop aux ctxt Prio_Unary "-" e
  | Expr_Bool(b) -> string_of_value (Bool b)
  | Expr_Plus(e,f) -> print_binop aux ctxt Prio_Plus " + " e f
  | Expr_Minus(e,f) -> print_binop aux ctxt Prio_Minus " - " e f
  | Expr_Mult(e,f) -> print_binop aux ctxt Prio_Mult " * " e f
  | Expr_Div(e,f) -> print_binop aux ctxt Prio_Div " / " e f
  | Expr_Pow(e,f) -> print_binop aux ctxt Prio_Pow "^" e f
  | Expr_Equal(e,f) -> print_binop aux ctxt Prio_Comp " = " e f
  | Expr_NotEqual(e,f) -> print_binop aux ctxt Prio_Comp " != " e f
  | Expr_Less(e,f) -> print_binop aux ctxt Prio_Comp " < " e f
  | Expr_LessEqual(e,f) -> print_binop aux ctxt Prio_Comp " <= " e f
  | Expr_Greater(e,f) -> print_binop aux ctxt Prio_Comp " < " e f
  | Expr_GreaterEqual(e,f) -> print_binop aux ctxt Prio_Comp " <= " e f
  | Expr_And(e,f) -> print_binop aux ctxt Prio_And " && " e f
  | Expr_Or(e,f) -> print_binop aux ctxt Prio_Or " || " e f
  | Expr_Not(e) -> print_uniop aux ctxt Prio_Unary "~" e
  | _ -> failwith "string_of_expr: Unsupported expression"
  in
    aux Prio_MIN

(** [get_space] calcul un décalage (blanc) pour affichage *)
let rec get_space max offset = 
  if offset >= (max+4) then
    get_space (max+10) offset
  else
    max-offset

(** {2 Fonctions utiles divers} *)

(** [uniq l] supprime les doublons d'une liste 
    @param la liste
*)
let rec uniq l = match l with  | [] -> []
  | x :: xs -> [x] @ (uniq (List.filter (fun y->y<>x) xs))

let xor a b = (a && not b) || (not a && b) 

(** [equal_expr] détermine si 2 expressions sont égales *)
let rec equal_expr e1 e2 = match e1, e2 with
  | Expr_Var(s1), Expr_Var(s2) -> s1 = s2
  | Expr_Num(n1), Expr_Num(n2) -> n1 == n2
  | Expr_Bool(b1), Expr_Bool(b2) -> not (xor b1 b2)
  | Expr_Neg(e1), Expr_Neg(e2) -> equal_expr e1 e2
  | Expr_Plus(e1a,e1b), Expr_Plus(e2a,e2b) -> equal_expr e1a e2a && equal_expr e1b e2b
  | Expr_Minus(e1a,e1b), Expr_Minus(e2a,e2b) -> equal_expr e1a e2a && equal_expr e1b e2b
  | Expr_Mult(e1a,e1b), Expr_Mult(e2a,e2b) -> equal_expr e1a e2a && equal_expr e1b e2b
  | Expr_Div(e1a,e1b), Expr_Div(e2a,e2b) -> equal_expr e1a e2a && equal_expr e1b e2b
  | Expr_Pow(e1a,e1b), Expr_Pow(e2a,e2b) -> equal_expr e1a e2a && equal_expr e1b e2b
  | Expr_Equal(e1a,e1b), Expr_Equal(e2a,e2b) -> equal_expr e1a e2a && equal_expr e1b e2b
  | Expr_NotEqual(e1a,e1b), Expr_NotEqual(e2a,e2b) -> equal_expr e1a e2a && equal_expr e1b e2b
  | Expr_Less(e1a,e1b), Expr_Less(e2a,e2b) -> equal_expr e1a e2a && equal_expr e1b e2b
  | Expr_LessEqual(e1a,e1b), Expr_LessEqual(e2a,e2b) -> equal_expr e1a e2a && equal_expr e1b e2b
  | Expr_Greater(e1a,e1b), Expr_Greater(e2a,e2b) -> equal_expr e1a e2a && equal_expr e1b e2b
  | Expr_GreaterEqual(e1a,e1b), Expr_GreaterEqual(e2a,e2b) -> equal_expr e1a e2a && equal_expr e1b e2b
  | Expr_And(e1a,e1b), Expr_And(e2a,e2b) -> equal_expr e1a e2a && equal_expr e1b e2b
  | Expr_Or(e1a,e1b), Expr_Or(e2a,e2b) -> equal_expr e1a e2a && equal_expr e1b e2b
  | Expr_Not(e1), Expr_Not(e2) -> equal_expr e1 e2
  | _,_ -> false


(** {2 Fonctions d'entrée/sortie fichiers} *)

(**/**)
(*  Voir 
    http://stackoverflow.com/questions/11276985/emulating-try-with-finally-in-ocaml *)
let unwind ~protect f x =
  let module E = struct type 'a t = Left of 'a | Right of exn end in
  let res = try E.Left (f x) with e -> E.Right e in
  let () = protect x in
  match res with
  | E.Left  y -> y
  | E.Right e -> raise e

let with_input_channel inch f =
  unwind ~protect:close_in f inch

let with_output_channel otch f =
  unwind ~protect:close_out f otch

let with_input_file fname =
  with_input_channel (open_in fname)

let with_output_file fname =
  with_output_channel (open_out fname)
(**/**)

(** [parse filename] analyse le fichier [filename] et produit la
    représentation abstraite du programme qu’il contient *)
let parse source =
  with_input_file source
  (fun ch ->
    Parser.make_prog Lexer.make_token (Lexing.from_channel ch)
  )

